home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / FROMUTS / XLISP1 / !XLisp / c / XLDBUG < prev    next >
Text File  |  1990-02-23  |  4KB  |  192 lines
  1. /* xldebug - xlisp debugging support */
  2. /*    Copyright (c) 1985, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use    */
  5.  
  6. #include "xlisp.h"
  7.  
  8. /* external variables */
  9. extern long total;
  10. extern int xldebug;
  11. extern int xltrace;
  12. extern int xlsample;
  13. extern NODE *s_unbound;
  14. extern NODE *s_stdin,*s_stdout;
  15. extern NODE *s_tracenable,*s_tlimit,*s_breakenable;
  16. extern NODE ***xlstack;
  17. extern NODE *true;
  18. extern NODE **trace_stack;
  19. extern char buf[];
  20.  
  21. /* external routines */
  22. extern char *malloc();
  23.  
  24. /* forward declarations */
  25. FORWARD NODE *stacktop();
  26.  
  27. /* xlfail - xlisp error handler */
  28. /*VARARGS*/
  29. xlfail(emsg)
  30.   char *emsg;
  31. {
  32.     xlerror(emsg,stacktop());
  33. }
  34.  
  35. /* xlabort - xlisp serious error handler */
  36. xlabort(emsg)
  37.   char *emsg;
  38. {
  39.     xlsignal(emsg,s_unbound);
  40. }
  41.  
  42. /* xlbreak - enter a break loop */
  43. xlbreak(emsg,arg)
  44.   char *emsg; NODE *arg;
  45. {
  46.     breakloop("break",NULL,emsg,arg,TRUE);
  47. }
  48.  
  49. /* xlerror - handle a fatal error */
  50. xlerror(emsg,arg)
  51.   char *emsg; NODE *arg;
  52. {
  53.     doerror(NULL,emsg,arg,FALSE);
  54. }
  55.  
  56. /* xlcerror - handle a recoverable error */
  57. xlcerror(cmsg,emsg,arg)
  58.   char *cmsg,*emsg; NODE *arg;
  59. {
  60.     doerror(cmsg,emsg,arg,TRUE);
  61. }
  62.  
  63. /* xlerrprint - print an error message */
  64. xlerrprint(hdr,cmsg,emsg,arg)
  65.   char *hdr,*cmsg,*emsg; NODE *arg;
  66. {
  67.     sprintf(buf,"%s: %s",hdr,emsg); stdputstr(buf);
  68.     if (arg != s_unbound) { stdputstr(" - "); stdprint(arg); }
  69.     else xlterpri(getvalue(s_stdout));
  70.     if (cmsg) { sprintf(buf,"if continued: %s\n",cmsg); stdputstr(buf); }
  71. }
  72.  
  73. /* doerror - handle xlisp errors */
  74. LOCAL doerror(cmsg,emsg,arg,cflag)
  75.   char *cmsg,*emsg; NODE *arg; int cflag;
  76. {
  77.     /* make sure the break loop is enabled */
  78.     if (getvalue(s_breakenable) == NIL)
  79.     xlsignal(emsg,arg);
  80.  
  81.     /* call the debug read-eval-print loop */
  82.     breakloop("error",cmsg,emsg,arg,cflag);
  83. }
  84.  
  85. /* breakloop - the debug read-eval-print loop */
  86. LOCAL int breakloop(hdr,cmsg,emsg,arg,cflag)
  87.   char *hdr,*cmsg,*emsg; NODE *arg; int cflag;
  88. {
  89.     NODE ***oldstk,*expr,*val;
  90.     CONTEXT cntxt;
  91.     int type;
  92.  
  93.     /* print the error message */
  94.     xlerrprint(hdr,cmsg,emsg,arg);
  95.  
  96.     /* flush the input buffer */
  97.     xlflush();
  98.  
  99.     /* do the back trace */
  100.     if (getvalue(s_tracenable)) {
  101.     val = getvalue(s_tlimit);
  102.     xlbaktrace(fixp(val) ? (int)getfixnum(val) : -1);
  103.     }
  104.  
  105.     /* create a new stack frame */
  106.     oldstk = xlsave(&expr,(NODE **)NULL);
  107.  
  108.     /* increment the debug level */
  109.     xldebug++;
  110.  
  111.     /* debug command processing loop */
  112.     xlbegin(&cntxt,CF_ERROR|CF_CLEANUP|CF_CONTINUE,true);
  113.     for (type = 0; type == 0; ) {
  114.  
  115.     /* setup the continue trap */
  116.     if (type = setjmp(cntxt.c_jmpbuf))
  117.         switch (type) {
  118.         case CF_ERROR:
  119.             xlflush();
  120.             type = 0;
  121.             continue;
  122.         case CF_CLEANUP:
  123.             continue;
  124.         case CF_CONTINUE:
  125.             if (cflag) {
  126.             stdputstr("[ continue from break loop ]\n");
  127.             continue;
  128.             }
  129.             else xlabort("this error can't be continued");
  130.         }
  131.  
  132.     /* read an expression and check for eof */
  133.     if (!xlread(getvalue(s_stdin),&expr,FALSE)) {
  134.         type = CF_CLEANUP;
  135.         break;
  136.     }
  137.  
  138.     /* evaluate the expression */
  139.     expr = xleval(expr);
  140.  
  141.     /* print it */
  142.     xlprint(getvalue(s_stdout),expr,TRUE);
  143.     xlterpri(getvalue(s_stdout));
  144.     }
  145.     xlend(&cntxt);
  146.  
  147.     /* decrement the debug level */
  148.     xldebug--;
  149.  
  150.     /* restore the previous stack frame */
  151.     xlstack = oldstk;
  152.  
  153.     /* check for aborting to the previous level */
  154.     if (type == CF_CLEANUP) {
  155.     stdputstr("[ abort to previous level ]\n");
  156.     xlsignal(NULL,NIL);
  157.     }
  158. }
  159.  
  160. /* stacktop - return the top node on the stack */
  161. LOCAL NODE *stacktop()
  162. {
  163.     return (xltrace >= 0 && xltrace < TDEPTH ? trace_stack[xltrace] : s_unbound);
  164. }
  165.  
  166. /* baktrace - do a back trace */
  167. xlbaktrace(n)
  168.   int n;
  169. {
  170.     int i;
  171.  
  172.     for (i = xltrace; (n < 0 || n--) && i >= 0; i--)
  173.     if (i < TDEPTH)
  174.         stdprint(trace_stack[i]);
  175. }
  176.  
  177. /* xldinit - debug initialization routine */
  178. xldinit()
  179. {
  180.     if ((trace_stack = (NODE **)malloc(TDEPTH * sizeof(NODE *))) == NULL) {
  181.     printf("insufficient memory");
  182.     osfinish();
  183.     exit(1);
  184.     }
  185.     total += (long)(TDEPTH * sizeof(NODE *));
  186.     xlsample = 0;
  187.     xltrace = -1;
  188.     xldebug = 0;
  189. }
  190.  
  191.  
  192.